home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PD Collection CD 1
/
PD Collection CD 1.iso
/
programer2
/
pari2
/
pari
/
other
/
gpreadline
< prev
next >
Wrap
Text File
|
1991-11-28
|
15KB
|
511 lines
/*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*/
/*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*/
/*@ @*/
/*@ PARI CALCULATOR @*/
/*@ @*/
/*@ copyright Babe Cool @*/
/*@ @*/
/*@ @*/
/*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*/
/*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*/
#include "genpari.h"
#include <readline/readline.h>
#include <readline/history.h>
long champ, dec, nbchi, avloc, avglob;
long prettyp = 1, chrono = 0;
char prompt[79], format;
#define NUMGLOB sizeof(globales)/4
static char *globales[] = {"precision", "serieslength", "format", "prompt"};
void escape();
void commands(), gentypes(), aide(), globs();
long timer();
char* findsep(t)
char **t;
{
char *s1;
static char s2[80];
int i;
for(s1 = *t, i = 0; (i < 79) && (*s1) && (!separe(*s1)); i++) s2[i] = *s1++;
while ((*s1) && (!separe(*s1))) s1++;
s2[i] = 0; *t = s1;
return s2;
}
void checkok(t)
char *t;
{
char c = *t;
if((c) && (!separe(c))) err(caracer1,t);
}
long getint(ch, n)
char *ch;
long n;
{
long av = avma;
filtre(ch);
if (*ch) n = itos(readexpr(&ch));
avma = av; return n;
}
void usage(s)
char *s;
{
pariputs(" ### usage: ");
pariputs(s);
pariputs("[-s stacksize] [-p primes] [-b buffersize]\n");
exit(0);
}
main(argc,argv)
long argc;
char **argv;
{
long i,typy, parisize, primelimit, silent;
static long tloc,listloc;
char *buffer, *tch, *tch2, thestring[100];
GEN z;
long tmpparibuffsize=0;
#ifdef macintosh
strcpy(prompt,"?\n"); parisize = 1000000; primelimit = 200000;
#else
strcpy(prompt,"? "); parisize = 4000000; primelimit = 500000;
#endif
for(i = 1; i < argc; i++)
{
tch = argv[i++];
if ((i == argc) || (*tch++ != '-')) usage(argv[0]);
if (*tch == 's') parisize = atoi(argv[i]);
else if (*tch == 'p') primelimit = atoi(argv[i]);
else if (*tch == 'b') tmpparibuffsize = atoi(argv[i]);
else usage(argv[0]);
}
printversion();
pariputs("\n Authors: C. Batut, D. Bernardi, H. Cohen and M. Olivier\n\n");
init(parisize, primelimit);
if(tmpparibuffsize) paribuffsize=tmpparibuffsize;
buffer = (char *)malloc(paribuffsize);
avglob = avloc = avma;
tglobal=0;chrono=0;
prec=5;precdl=16;dec=28;nbchi=28;champ=0;format='g';
pariputs("Type \\d, \\c, \\t, or ?command for help, \\q to exit, # for timing\n\n");
globs(parisize,primelimit);
for(;;)
{
avloc = avma; tloc = tglobal; listloc = marklist();
if (setjmp(environnement)) {avma = avloc; tglobal = tloc; recover(listloc);}
if(infile!=stdin)
{
if (!fgets(buffer, paribuffsize, infile)) {switchin(NULL); continue;}
}
else
{
pariputs(prompt);
#ifdef _READLINE_H_
char *_str;
int _len;
if(buffer) free(buffer);
do {
buffer = readline("");
if(!buffer) strcpy("\\q",buffer);
tch = buffer;
while (isspace(*tch)) tch++;
} while(!*tch);
if (*tch == '{')
for(*tch = ' ';;)
{
tch = buffer + strlen(buffer) - 1;
if (*tch == '}') {*tch = 0; break;}
if (*tch++ == '\\') tch--; else *tch++ = '\n';
_len = tch - buffer;
_str = readline("");
if(!_str) _str = "";
buffer = (char *)realloc(buffer, _len + strlen(_str));
strcpy(buffer + _len, _str);
}
else
for(;;)
{
tch = buffer + strlen(buffer) - 1;
if (*tch != '\\') break;
_len = tch - buffer;
_str = readline("");
if(!_str) _str = "";
buffer = (char *)realloc(buffer, _len + strlen(_str));
strcpy(buffer + _len, _str);
}
if(*buffer) add_history(buffer);
#else
if (!fgets(buffer, paribuffsize, infile)) {switchin(NULL); continue;}
#endif
}
if (echo) pariputs(buffer); else if (logfile) fputs(buffer, logfile);
tch = buffer + 1;
switch(buffer[0])
{
case '#':
checkok(tch);
pariputs((chrono = !chrono) ? " timer on\n" : " timer off\n");
continue;
case '?': aide(findsep(&tch)); pariputc('\n'); continue;
case '\\': escape(tch,parisize,primelimit); continue;
case '{':
for(;;)
{
tch2 = buffer + strlen(buffer) - 1;
if (*tch2 == '\n') tch2--;
if (*tch2 == '}') {*tch2-- = 0; break;}
if (*tch2 != '\\') tch2++;
if(!fgets(tch2, paribuffsize - (tch2 - buffer), infile)) break;
if(echo) pariputs(tch2); else if (logfile) fputs(tch2, logfile);
}
break;
default:
for(tch--;;)
{
tch2 = buffer + strlen(buffer) - 1;
if (*tch2 == '\n') tch2--;
if (*tch2 != '\\') {tch2[1] = 0; break;}
if(!fgets(tch2, paribuffsize - (tch2 - buffer), infile)) break;
if(echo) pariputs(tch2); else if (logfile) fputs(tch2, logfile);
}
break;
}
silent = separe(*tch2);
filtre(tch);
fflush(outfile); if (logfile) fflush(logfile);
if (chrono) timer();
z = readseq(&tch);
nbchi=dec=glbfmt[2];
if (*tch) {pariputs(" unused characters: "); pariputs(tch); pariputc('\n');}
if (chrono)
{
long delay = timer();
pariputs("time = ");
if (delay >= 3600000)
{
sprintf(thestring, "%dh, ", delay / 3600000);
delay %= 3600000;
pariputs(thestring);
}
if (delay >= 60000)
{
sprintf(thestring, "%dmn, ", delay / 60000);
delay %= 60000;
pariputs(thestring);
}
if (delay >= 1000)
{
sprintf(thestring, "%d,", delay / 1000);
delay %= 1000;
pariputs(thestring);
if (delay < 100) pariputc('0');
if (delay < 10) pariputc('0');
}
sprintf(thestring, "%d ms\n", delay);
pariputs(thestring);
}
if (z == gnil) continue;
g[0] = g[++tglobal] = isonstack(z) ? z : gcopy(z);
typy=typ(z);
if (!separe(*tch2))
{
sprintf(thestring, "%%%d = ",tglobal);
pariputs(thestring);
if ((typy > 16) && (prettyp==2)) pariputc('\n');;
if(nbchi < 0)
if(prettyp==2) sor(z, format, -1, champ);
else if(prettyp) matbrute(z, format, -1);
else brute(z, format, -1);
else
if (typy < 3) ecrire(z, format, nbchi, 0);
else
if(prettyp==2) sor(z, format, nbchi, champ);
else if(prettyp) matbrute(z, format, nbchi);
else brute(z, format, nbchi);
pariputc('\n');
}
} /* for(;;) */
} /* main */
/********************************************************************/
/********************************************************************/
/** **/
/** COMMANDES COMMENCANT PAR \ **/
/** **/
/********************************************************************/
/********************************************************************/
void escape(tch,parisize,primelimit)
char *tch;
long parisize,primelimit;
{
int i, d;
char c, *s1, *s2, thestring[50];
for (i=0;i<NUMGLOB;i++)
{
s1 = tch;
s2 = globales[i];
while ((*s2) && (*s1 == *s2)) {s1++; s2++;}
while (isspace(*s1)) s1++;
if (!*s2 && (*s1++ == '='))
switch (i)
{
case 0:
glbfmt[2] = nbchi = dec = getint(s1, dec);
prec = dec * K1 + 3;
sprintf(thestring, " precision = %d significant digits\n",dec);
pariputs(thestring);
return;
case 1:
precdl = getint(s1);
sprintf(thestring, " series precision = %d significant terms\n",precdl);
pariputs(thestring);
return;
case 2:
format = *s1++;
if(isdigit(*s1))
for(champ = 0; isdigit(*s1); s1++)
champ = 10 * champ + *s1 - '0';
if(*s1++ == '.')
if(*s1 == '-')
nbchi = -1;
else
if(isdigit(*s1))
for(nbchi = 0; isdigit(*s1); s1++)
nbchi = 10 * nbchi + *s1 - '0';
sprintf(thestring, " real format = %c%d.%d\n", format, champ, nbchi);
pariputs(thestring);
glbfmt[0] = format; glbfmt[1] = champ; glbfmt[2] = nbchi;
return;
case 3:
strcpy(prompt, findsep(&s1));
#ifdef macintosh
strcat(prompt,"\n");
#else
strcat(prompt," ");
#endif
return;
}
}
c = *tch++;
switch (isupper(c) ? tolower(c) : c)
{
case 'a': brute(g[getint(tch, tglobal)], format, -1);pariputc('\n');break;
case 'b': sor(g[getint(tch, tglobal)], format, -1, champ);pariputc('\n');
break;
case 'c': checkok(tch); commands(); break;
case 'd': checkok(tch); globs(parisize,primelimit); break;
case 'e': checkok(tch); echo = !echo; break;
case 'k': checkok(tch);
avma = avloc = avglob;
tglobal = chrono = 0;
gpi = geuler = bernzone = (GEN)0;
prec = 5; precdl = 16; dec = 28; nbchi = 28; champ = 0; format = 'g';
#ifdef macintosh
strcpy(prompt,"?\n");
#else
strcpy(prompt,"? ");
#endif
for (i = 0; i < STACKSIZE; i++) g[i] = gzero;
globs(parisize,primelimit);
break;
case 'l': checkok(tch); fliplog(); break;
case 'm': matbrute(g[getint(tch, tglobal)], format, -1);pariputc('\n');
break;
case 'p': checkok(tch); prettyp = (prettyp==2)?0:prettyp+1;
if(prettyp==2)
{
sprintf(thestring, " default format: prettyprint\n");
pariputs(thestring);
}
else if(prettyp)
{
sprintf(thestring, " default format: prettymatrix\n");
pariputs(thestring);
}
else
{
sprintf(thestring, " default format: raw\n");
pariputs(thestring);
}
break;
case 'q': exit(0);
case 'r': while(isspace(*tch)) tch++; switchin(findsep(&tch)); break;
case 's': etatpile(getint(tch, 0)); break;
case 't': checkok(tch); gentypes(); break;
case 'v': checkok(tch); printversion(); break;
case 'w':
while(isspace(*tch)) tch++;
for (d = 0; isdigit(*tch);) d = 10 * d + *tch++ - '0';
while(isspace(*tch)) tch++;
switchout(findsep(&tch));
brute(g[d ? d : tglobal], format, -1);
pariputc('\n'); switchout(NULL); break;
case 'x': voir(g[tglobal], getint(tch, -1)); break;
case '\\': break;
default: err(caracer1,tch+1);
}
}
/********************************************************************/
/********************************************************************/
/** **/
/** AFFICHAGE TYPES, COMMANDES AIDES ET GLOBALES **/
/** **/
/********************************************************************/
/********************************************************************/
void gentypes()
{
pariputs("\n List of the PARI types :");
pariputs("\n -------------------------\n\n");
pariputs(" 1 :long integers [ cod1 ] [ cod2 ] [ man1 ] ... [ manl ]\n");
pariputs(" 2 :long real numbers [ cod1 ] [ cod2 ] [ man1 ] ... [ manl ]\n");
pariputs(" 3 :integermods [ code ] [ mod ] [ integer ]\n");
pariputs(" 4 :irred. rationals [ code ] [ num. ] [ den. ] \n");
pariputs(" 5 :rational numbers [ code ] [ num. ] [ den. ] \n");
pariputs(" 6 :complex numbers [ code ] [ real ] [ imag ] \n");
pariputs(" 7 :p-adic numbers [ cod1 ] [ cod2 ] [ p ] [ p^r ] [ integer]\n");
pariputs(" 8 :quadratic numbers [ cod1 ] [ mod ] [ real ] [ imag ]\n");
pariputs(" 9 :polymods [ code ] [ mod ] [ polynomial ]\n");
pariputs(" -------------------------------------------------------------\n");
pariputs(" 10 :polynomials [ cod1 ] [ cod2 ] [ man1 ] ... [ manl ]\n");
pariputs(" 11 :power series [ cod1 ] [ cod2 ] [ man1 ] ... [ manl ]\n");
pariputs(" 13 :irred. rat. func. [ code ] [ num. ] [ den. ]\n");
pariputs(" 14 :rational function [ code ] [ num. ] [ den. ]\n");
pariputs(" 17 :row vector [ code ] [ x1 ] ... [ xl ] \n");
pariputs(" 18 :column vector [ code ] [ x1 ] ... [ xl ] \n");
pariputs(" 19 :matrix [ code ] [ col1 ] ... [ coll ]\n");
}
void commands()
{
int i, j;
for (i = 0; i < NUMFUNC; i++)
{
if (!(i % 6)) pariputc('\n');
if (i && !(i % 60)) pariputc('\n');
if (i && !(i % 120)) {pariputs("---- (type return to continue) ----\n");getchar();}
pariputs(fonctions[i].name);
for(j = strlen(fonctions[i].name); j < 12; j++) pariputc(' ');
}
pariputc('\n');
}
void globs(parisize,primelimit)
long parisize,primelimit;
{
int i, j;
char thestring[70];
for (i = 0; i < NUMGLOB; i++)
{
pariputc('\\'); pariputs(globales[i]);
for(j = strlen(globales[i]); j < 15; j++) pariputc(' ');
pariputs("= ");
switch (i)
{
case 0: sprintf(thestring, "%d",dec);break;
case 1: sprintf(thestring, "%d",precdl);break;
case 2: sprintf(thestring, "%c%d.%d",format,champ,nbchi);break;
case 3: sprintf(thestring, "%s",prompt);break;
}
pariputs(thestring); pariputc('\n');
}
sprintf(thestring, "stacksize = %ld, prime limit = %ld, buffersize = %ld",parisize, primelimit, paribuffsize);pariputs(thestring);
pariputc('\n');
}
void aide(s)
char *s;
{
long i, n, nparam;
char *u = s;
entree *ep, **q;
if (!*s) {commands(); return;}
for (n=0;n<NUMFUNC;n++)
if(!strcmp(fonctions[n].name,s))
{pariputs(helpmessage[n]); pariputc('.'); return;}
for(n = 0; isalnum(*u); u++) n = n << 1 ^ *u;
if (n < 0) n = -n; n %= TBLSZ;
for(ep = hashtable[n]; ep; ep = ep->next)
if(!strcmp(ep->name,s))
{
if (ep->valence != 100) break;
q = (entree **)(ep->value);
nparam = (long)*q++;
pariputs(ep->name);
pariputc('(');
for(i = 0; i < nparam; i++)
{
if(i) pariputc(',');
pariputs((*q++)->name);
}
pariputs(")= ");
pariputs(q);
return;
}
pariputs("Unknown function\n");
}
/********************************************************************/
/********************************************************************/
/** **/
/** MESURE DU TEMPS **/
/** **/
/********************************************************************/
/********************************************************************/
#ifdef macintosh
pascal unsigned long TickCount(void) = 0xA975;
long timer()
{
static long oldticks;
long ticks = TickCount();
long delay = ticks - oldticks;
oldticks = ticks;
return 50 * delay / 3;
}
#else
long timer()
{
static long oldmusec;
static long oldsec;
long delay;
struct rusage r;
struct timeval t;
getrusage(0,&r);t=r.ru_utime;
delay = 1000 * (t.tv_sec - oldsec) + (t.tv_usec - oldmusec) / 1000;
oldmusec = t.tv_usec;
oldsec = t.tv_sec;
return delay;
}
#endif